home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 7 / FM Towns Free Software Collection 7.iso / t_os / am_dfc7 / am_dfc7.bas next >
BASIC Source File  |  1993-11-30  |  11KB  |  291 lines

  1. 1000 CLEAR ,,4096,1024*720
  2. 1010 DEFINT A-Z:BGM 1:FOR I=0 TO 13:PART I,I:NEXT:MOUSE 0
  3. 1020 SCREEN@ 0:SCREEN 0:CLS:COLOR ,,,4:CONSOLE 0,25,0:ON ERROR GOTO *TRAP
  4. 1030 DIM UNDO&(38400),UNDO2&(38400),CCD(15),TRP(5120)
  5. 1040 LM=14
  6. 1050 DIM FM(LM),PCM(LM),MLOOP(LM),FL$(LM),SW(LM),MN$(LM+1),TRK(5),M$(127)
  7. 1060 T&=63724/2:DIM O_TRK(T&),Q_TRK(T&),P_TRK(T&),R_TRK(T&),S_TRK(T&)
  8. 1070 T&=13990/2:DIM O_INT(T&),Q_INT(T&),P_INT(T&),R_INT(T&),S_INT(T&)
  9. 1080 DIM FMB$(9),PMB$(9),DFILE$(9)
  10. 1090 MX=0:MY=0:LX=256:LY=15:T_LP=0:MCOU=24
  11. 1100 みかげ=0:表紙=0:FLG=0
  12. 1110 NFM=999:NPCM=999:NMML=999
  13. 1120  TRK(1)=999:TRK(2)=999:TRK(3)=999:TRK(4)=999:TRK(5)=999
  14. 1130  GOSUB *DATA_DIVISION
  15. 1140  CLS
  16. 1150 '
  17. 1160 WHILE -1:LSY=16:UPD=0
  18. 1170  IF 表紙<>2 THEN GOSUB *画面描く:MENU=0:MMENU=2:GOSUB *LINE_XOR
  19. 1180  MOUSE 1,0,0,0
  20. 1190  GOSUB *SELECT_MENU:IF PT>1 THEN GOSUB *M_STOP:UMENU=MENU:MENU=-1
  21. 1200  GOSUB *LINE_XOR:MAINMENU=MENU
  22. 1210  ON MENU+1 GOSUB *MUSIC_MODE,*DOC_READ,*SYS_RET
  23. 1220  IF MENU=-1 THEN 表紙=2:MENU=UMENU ELSE 表紙=1
  24. 1230 WEND
  25. 1240 '
  26. 1250 *SELECT_MENU:MOUSE 4,0,0,15,MMENU*16+15
  27. 1260  PT=0 : IF MAINMENU<>3 THEN GOSUB *PT_WAIT
  28. 1270   WHILE PT=0
  29. 1280     GOSUB *MS_GET:PT=-MOUSE(2,0) OR -MOUSE(2,1)*2
  30. 1290     IF PLAY(0)=0 AND FLG THEN GOSUB *MUSIC_ERASE
  31. 1300   WEND
  32. 1310   RETURN
  33. 1320   '
  34. 1330   *MUSIC_ERASE:FLG=0
  35. 1340     LINE(0,339)-(317,377),PSET,%1,BF:RETURN
  36. 1350   *MS_GET
  37. 1360        PD=MOUSE(1)\16
  38. 1370         IF PD<>UPD THEN GOSUB *MOVE_MENU
  39. 1380    RETURN
  40. 1390   *LINE_XOR:Y=MENU*LSY
  41. 1400    LINE(MX,MY+Y)-(MX+LX,MY+LY+Y),XOR,%3,BF
  42. 1410    RETURN
  43. 1420   *MOVE_MENU
  44. 1430    GOSUB *LINE_XOR:MENU=PD:SWAP C1,C2:GOSUB *LINE_XOR:UPD=PD
  45. 1440    RETURN
  46. 1450   *MOUSE_COUNT:MOUSE 3,1,MCOU:MOUSE 3,0,MCOU:RETURN
  47. 1460   *PT_WAIT:WHILE MOUSE(2,0) OR MOUSE(2,1):WEND:RETURN
  48. 1470   *MS_WAIT2:B=80 : A=1 : WHILE A:A=MOUSE(2,0):B=B-1
  49. 1480                           IF B=0 THEN A=0
  50. 1490                          WEND : RETURN
  51. 1500   *WAIT_REP:WAIT 1:WAIT 1:WAIT 1:WAIT 1:RETURN
  52. 1510   *BEEP_SE:FOR Z=0 TO 4:BEEP 363523,1,1200:WAIT 8:NEXT:RETURN
  53. 1520 *SCREEN_OUT:SX=319
  54. 1530 *SCREEN_OUT2
  55. 1540     FOR I=0 TO L\2
  56. 1550         LINE(0,I*2)-STEP(SX,0),PSET,0
  57. 1560         LINE(0,L-1-I*2)-STEP(SX,0),PSET,0:WAIT 1
  58. 1570     NEXT:RETURN
  59. 1580 '
  60. 1620  *画面描く
  61. 1630   LINE (0,0)-(255,255),PSET,%1,BF:LX=255
  62. 1640   IF 表紙=0 THEN GOSUB *画面描く2:RETURN
  63. 1650   PUT@A(0,0)-(639,479),UNDO&:RETURN
  64. 1660   *画面描く2:LINE(MX,MY)-(MX+640,MY+399),PSET,%1,BF
  65. 1670               GOSUB *画面描く3
  66. 1680   LOAD@"apple_3b.tif",(320,0)
  67. 1690   SYMBOL(MX,MY   ),"曲を聴く",1,1,7,,,5,1
  68. 1700   SYMBOL(MX,MY+16),"ドキュメントを読む",1,1,7,,,5,1
  69. 1710   SYMBOL(MX,MY+32),"システムに戻る",1,1,7,,,5,1
  70. 1720   GET@A(0,0)-(639,479),UNDO&:RETURN
  71. 1730  *画面描く3
  72. 1740   SYMBOL(31,410),"TwinkleSoft音楽集 VOL.2",2,3,4
  73. 1750   SYMBOL(32,410),"TwinkleSoft音楽集 VOL.2",2,3,4
  74. 1760   SYMBOL(192,457),"by Twinkle SOFT",1,1.5!,7,,,1
  75. 1770   RETURN
  76. 1780 '
  77. 1790 *SYS_RET
  78. 1800  SYMBOL(32,256),"本当にいいですか? yes>LEFT push --- no>RIGHT push",1,1,7
  79. 1810  GOSUB *BEEP_SE:GOSUB *PT_WAIT
  80. 1820  PT=0:WHILE PT=0:PT=-MOUSE(2,0) OR -MOUSE(2,1)*2:WEND
  81. 1830  IF PT=1 THEN L=480:GOSUB *SCREEN_OUT:SYSTEM
  82. 1840  LINE(32,128)-(23*16+32,143),PSET,%1,BF:GOSUB *PT_WAIT:RETURN
  83. 1850 *DOC_READ
  84. 1860  L=480:SX=639:GOSUB *SCREEN_OUT2:EOM=1
  85. 1870  WHILE EOM:A=1:B=7:C!=1.5!
  86. 1880  LINE(MX,MY)-(MX+640,MY+480),PSET,%A,BF
  87. 1890  SYMBOL(MX,MY   ),"by TwinkleSoft",C!,A,B
  88. 1900  SYMBOL(MX,MY+16),"by 編曲主任",C!,A,B
  89. 1910  SYMBOL(MX,MY+32),"あとがき",C!,A,B
  90. 1920  SYMBOL(MX,MY+48),"戻る",C!,A,B
  91. 1930  MENU=0:MMENU=3:GOSUB *LINE_XOR:GOSUB *PT_WAIT:UPD=0:MOUSE 1,0,0,0
  92. 1940    GOSUB *SELECT_MENU
  93. 1950    IF PT=1 THEN GOSUB *DOC_FILER ELSE GOSUB *M_STOP
  94. 1960  WEND
  95. 1970  RETURN
  96. 1980  *DOC_FILER
  97. 1990   IF MENU=MMENU THEN EOM=0:RETURN
  98. 2000   FOR I=0 TO 26:M$(I)="":NEXT
  99. 2010   OPEN "I",#1,DFILE$(MENU)+".doc":I=0
  100. 2020    WHILE EOF(1)=0
  101. 2030     LINE INPUT #1,M$(I):I=I+1
  102. 2040    WEND:CLOSE #1:M=I
  103. 2050    LINE(MX,MY)-(MX+640,MY+480),PSET,%1,BF
  104. 2060    LINE(0,464)-(639,479),PSET,%2,BF
  105. 2070    SYMBOL(64,464),"左クリックしてね!",1.5!,1,7,,,1
  106. 2080     LOCATE 0,0:GOSUB *PT_WAIT
  107. 2090     FOR I=0 TO 23:PRINT M$(I):NEXT:D=1
  108. 2100    WHILE D:PT=0:A1=0:A2=0
  109. 2110     WHILE PT=0:PT=A1 OR A2:A1=-MOUSE(2,0):A2=-MOUSE(2,1)*2:WEND
  110. 2120     IF PT=2 THEN PT=2 ELSE GOSUB *DOC_NEXT
  111. 2130    WEND
  112. 2140   LINE(0,464)-(639,479),PSET,%2,BF
  113. 2150   SYMBOL(64,464),"右クリックで終了します。",1.5!,1,7,,,1
  114. 2160   GOSUB *BEEP_SE
  115. 2170   WHILE MOUSE(2,1)=0:WEND
  116. 2180   CLS 4:LINE(0,464)-(639,479),PSET,%1,BF
  117. 2190  RETURN
  118. 2200    *DOC_NEXT
  119. 2210       PRINT M$(I):I=I+1:GOSUB *MS_WAIT2:IF I>=M THEN D=0
  120. 2220      RETURN
  121. 2230 '
  122. 2240 '
  123. 2250 *MUSIC_MODE:GOSUB *PT_WAIT
  124. 2260   L=400:LX=480:GOSUB *SCREEN_OUT
  125. 2270   LINE(MX,MY)-(MX+319,MY+399),PSET,%1,BF
  126. 2280   IF みかげ THEN GOSUB *みかげちゃん愛してる!
  127. 2290   IF みかげ=0 THEN GOSUB *みかげちゃんこんにちわ!
  128. 2300   '
  129. 2310   LX=319:MENU=0:MMENU=LM+1:LSY=16:GOSUB *LINE_XOR:EOM=1
  130. 2320   MOUSE 1,0,0,0:UPD=0
  131. 2330   IF PLAY(0) THEN GOSUB *MUSIC_NOW_SYMBOL
  132. 2340  WHILE EOM
  133. 2350   GOSUB *SELECT_MENU
  134. 2360   IF PT=1 AND MENU=MMENU THEN EOM=0
  135. 2370   IF PT>1 THEN GOSUB *M_STOP ELSE GOSUB *M_LOAD_INIT
  136. 2380  WEND
  137. 2390  FLG=0:L=400:GOSUB *SCREEN_OUT
  138. 2400  RETURN
  139. 2410 *みかげちゃんこんにちわ!:GOSUB *M_STOP
  140. 2420   LINE(MX,MY)-(MX+319,MY+368),PSET,%1,BF
  141. 2480   X=0:FOR I=0 TO LM+1:SYMBOL(X,I*16),MN$(I),1,1,%15:NEXT
  142. 2490   GET@A(0,0)-(639,479),UNDO2&:みかげ=1
  143. 2500   RETURN
  144. 2510 *みかげちゃん愛してる!
  145. 2520   PUT@A(0,0)-(639,479),UNDO2&
  146. 2530   RETURN
  147. 2540 *M_STOP:PLAY OFF:RETURN
  148. 2550 *M_LOAD_INIT : IF EOM=0 THEN RETURN
  149. 2560   UY=MOUSE(1)
  150. 2570   MML=MENU:FILE$=FL$(MENU):FM=FM(MENU):PCM=PCM(MENU)
  151. 2580   SW=SW(MENU):GOSUB *M_STOP:GOSUB *FM_LOADER:GOSUB *PCM_LOADER
  152. 2590   GOSUB *MUSIC_LOADER
  153. 2600   SYMBOL(40,380),"ちょっと待っててね!",1.5!,1,%1
  154. 2610   'FOR I=1 TO 5:LRU(I)=(LRU(I)+1)AND 32767:NEXT:LRU(T)=0
  155. 2620   MOUSE 1,0,UY,0:RETURN
  156. 2630   *MUSIC_NOW_SYMBOL
  157. 2640    LINE(0,339)-(317,377),PSET,%15,BF,%1
  158. 2650    SYMBOL(64,340),"now PLAYING♪",1,1,7
  159. 2660    SYMBOL(0,359),MN$(MML),1,1,7:FLG=1:RETURN
  160. 2670 *MUSIC_LOADER
  161. 2680  PLAY OFF : GOSUB *MUSIC_NOW_SYMBOL
  162. 2690   A$="%C":PLAY A$,A$,A$,A$,A$,A$, A$,A$,A$,A$,A$,A$,A$,A$
  163. 2700   IF MML<>NMML THEN GOSUB *MUSIC_LOADER2
  164. 2710   RETURN
  165. 2720  '
  166. 2730  *MUSIC_LOADER2
  167. 2740  IF MLOOP(MENU)=999 THEN A=0 ELSE A=1
  168. 2750  GOSUB *MML_LOADER_CK:IF CK THEN RETURN
  169. 2760  M_TRK=T:TRK(T)=MML
  170. 2770  ON T GOSUB *O_TRK,*P_TRK,*Q_TRK,*R_TRK,*S_TRK
  171. 2780  RETURN
  172. 2790  *O_TRK
  173. 2800   IF SW THEN LOAD@ FILE$+"L.eup",O_INT,1
  174. 2810   LOAD@ FILE$+".eup",O_TRK,1:GOSUB *O_PLAY:RETURN
  175. 2820  *P_TRK
  176. 2830   IF SW THEN LOAD@ FILE$+"L.eup",P_INT,1
  177. 2840   LOAD@ FILE$+".eup",P_TRK,1:GOSUB *P_PLAY:RETURN
  178. 2850  *Q_TRK
  179. 2860   IF SW THEN LOAD@ FILE$+"L.eup",Q_INT,1
  180. 2870   LOAD@ FILE$+".eup",Q_TRK,1:GOSUB *Q_PLAY:RETURN
  181. 2880  *R_TRK
  182. 2890   IF SW THEN LOAD@ FILE$+"l.eup",R_INT,1
  183. 2900   LOAD@ FILE$+".eup",R_TRK,1:GOSUB *R_PLAY:RETURN
  184. 2910  *S_TRK
  185. 2920   IF SW THEN LOAD@ FILE$+"l.eup",S_INT,1
  186. 2930   LOAD@ FILE$+".eup",S_TRK,1:GOSUB *S_PLAY:RETURN
  187. 2940  '
  188. 2950  *MML_LOADER_CK:CK=0
  189. 2960  IF TRK(1)=MML THEN M_TRK=1:CK=1:GOSUB *O_PLAY:RETURN
  190. 2970  IF TRK(2)=MML THEN M_TRK=2:CK=1:GOSUB *P_PLAY:RETURN
  191. 2980  IF TRK(3)=MML THEN M_TRK=3:CK=1:GOSUB *Q_PLAY:RETURN
  192. 2990  IF TRK(4)=MML THEN M_TRK=4:CK=1:GOSUB *R_PLAY:RETURN
  193. 3000  IF TRK(5)=MML THEN M_TRK=5:CK=1:GOSUB *S_PLAY:RETURN
  194. 3010   T_LP=(T_LP+1)MOD 5:T=T_LP+1
  195. 3020   RETURN
  196. 3030  *O_PLAY:GOSUB *INTRO:PLAY@ O_TRK,A:RETURN
  197. 3040  *P_PLAY:GOSUB *INTRO:PLAY@ P_TRK,A:RETURN
  198. 3050  *Q_PLAY:GOSUB *INTRO:PLAY@ Q_TRK,A:RETURN
  199. 3060  *R_PLAY:GOSUB *INTRO:PLAY@ R_TRK,A:RETURN
  200. 3070  *S_PLAY:GOSUB *INTRO:PLAY@ S_TRK,A:RETURN
  201. 3080  *O_IT:PLAY@ O_INT,0:RETURN
  202. 3090  *P_IT:PLAY@ P_INT,0:RETURN
  203. 3100  *Q_IT:PLAY@ Q_INT,0:RETURN
  204. 3110  *R_IT:PLAY@ R_INT,0:RETURN
  205. 3120  *S_IT:PLAY@ S_INT,0:RETURN
  206. 3130 *INTRO:IF SW(MENU)=0 THEN RETURN
  207. 3140   T=M_TRK:ON T GOSUB *O_IT,*P_IT,*Q_IT,*R_IT,*S_IT
  208. 3150   SYMBOL(40,380),"ちょっと待っててね!",1.5!,1,%15
  209. 3160   WHILE PLAY(0):WEND
  210. 3170   RETURN
  211. 3180 '
  212. 3190 '
  213. 3200 *PCM_LOADER:E=0
  214. 3210  IF PCM=NPCM THEN RETURN ELSE PLAY OFF:E=1
  215. 3220  IF PCM THEN N$=PMB$(PCM):GOSUB *PMB_READ
  216. 3230  RETURN
  217. 3240  *PMB_READ : IF E THEN LOAD@ N$+".pmb":NPCM=PCM
  218. 3250  RETURN
  219. 3260 '
  220. 3270 *FM_LOADER:E=0
  221. 3280   IF FM=NFM THEN RETURN ELSE PLAY OFF:E=1
  222. 3290   IF FM THEN N$=FMB$(FM):GOSUB *FMB_READ
  223. 3300   RETURN
  224. 3310   *FMB_READ : IF E THEN LOAD@ N$+".fmb":NFM=FM
  225. 3320    RETURN
  226. 3330 '
  227. 3340 *DATA_DIVISION:RESTORE *DATA_DIVISION
  228. 3350  DFILE$(0)="twinkle":DFILE$(1)="has":DFILE$(2)="atogaki"
  229. 3360  FMB$(1)="CY_VOICE":FMB$(2)="xacs_fm2"
  230. 3370  PMB$(1)="cy_lips" :PMB$(2)="CY_LIPS1"
  231. 3380  PMB$(4)="cy_lips4":PMB$(5)="cy_lipsE":PMB$(6)="CY_LIPS6"
  232. 3390  PMB$(9)="pcm_05"
  233. 3400 FOR I=0 TO LM
  234. 3410  READ FL$(I):READ FM(I),PCM(I),MLOOP(I),SW(I)
  235. 3420 NEXT
  236. 3430 RESTORE *NAME_DIVISION
  237. 3440 FOR I=0 TO LM:READ MN$(I):NEXT:MN$(I)="  戻る"
  238. 3460 RETURN
  239. 3470 '     file      fm pcm loop sw
  240. 3480  DATA open_b  ,  1,  1, 999, 0
  241. 3490  DATA STAGE1  ,  1,  1,   0, 1
  242. 3500  DATA BOSS_1  ,  1,  2,   0, 0
  243. 3510  DATA stage4  ,  1,  4,   0, 0
  244. 3520  DATA stage5  ,  1,  1,   0, 1
  245. 3530  DATA boss_5  ,  1,  1,   0, 0
  246. 3540  DATA STAGE6  ,  1,  6,   0, 1
  247. 3550  DATA BOSS_6  ,  1,  6,   0, 0
  248. 3560  DATA ending_a,  1,  5, 999, 0
  249. 3570  DATA ramin   ,  1,  1,   0, 0
  250. 3580  DATA xacs013 ,  2,  9,   0, 1
  251. 3590  DATA xacs010 ,  2,  9,   0, 1
  252. 3600  DATA xacs007 ,  2,  9,   0, 1
  253. 3610  DATA xacs033 ,  2,  9,   0, 0
  254. 3620  DATA m_67a   ,  2,  0,   0, 0
  255. 3630  '
  256. 3640  *NAME_DIVISION
  257. 3650  '限界点-------------------|
  258. 3660  DATA CY-LIPS  Innermost keepers
  259. 3670  DATA CY-LIPS  Destructive Instinct
  260. 3680  DATA CY-LIPS  DNA-DRAGON
  261. 3690  DATA CY-LIPS  DIRECT ARTS
  262. 3700  DATA CY-LIPS  Elegant assault
  263. 3710  DATA CY-LIPS  EverShip
  264. 3720  DATA CY-LIPS  D-BEAT
  265. 3730  DATA CY-LIPS  NO comparison
  266. 3740  DATA CY-LIPS  HISTORY ONE MORE
  267. 3750  DATA CY-LIPS  常駐のテーマ
  268. 3760  DATA Legend of Calsurn   save your heart
  269. 3770  DATA Legend of Calsurn   We?
  270. 3780  DATA Legend of Calsurn   戦闘
  271. 3790  DATA Legend of Calsurn   MOT MIX
  272. 3800  DATA Legend of Calsurn   雪世界
  273. 3810  '
  274. 3820  'palette
  275. 3830  'DATA  273,1648,1437,1966,2511, 231,2298,3069
  276. 3840  'DATA 2569,3386,4013,2535,3065,3579,4093,4095
  277. 3850 *TRAP
  278. 3860 IF ERR=53 THEN RESUME NEXT
  279. 3870 FOR I=0 TO 31:BEEP 363523,1,1200:WAIT 1:BEEP 363523,1,1800:NEXT
  280. 3880 GET@A(0,400)-(639,431),TRP
  281. 3890 IF ERR=72 THEN GOSUB *FD_NOT_READY:RESUME
  282. 3900 LINE(0,400)-(639,479),PSET,%0,BF
  283. 3910 SYMBOL(0,416),"エラー発生 ERR="+STR$(ERR),1,1,7
  284. 3920 SYMBOL(0,432),"           ERL="+STR$(ERL),1,1,7
  285. 3930 GOSUB *PT_WAIT:WHILE MOUSE(2,0)=0 AND MOUSE(2,1)=0:WEND:END:SYSTEM
  286. 3940 *FD_NOT_READY
  287. 3950  SYMBOL(0,400),"フロッピーはいってないです",1.2!,1.4!,%15
  288. 3960  GOSUB *PT_WAIT:WHILE MOUSE(2,0)=0 AND MOUSE(2,1)=0:WEND
  289. 3970  GOSUB *PT_WAIT:PUT@A(0,400)-(639,431),TRP
  290. 3980  RETURN
  291.